home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Games of Daze
/
Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso
/
x2ftp
/
msdos
/
source
/
tileex
/
tileex.bas
< prev
Wrap
BASIC Source File
|
1995-03-10
|
14KB
|
307 lines
'This is a small program using tile graphics. This source code is the property
'of James Tonn. You may modify this source code and use it in your own
'programs. You may use it in a written publication provided that it is not
'altered, and that you give credit to the author (James Tonn).
'I hope this code will help you in your programming.
' -Jimmy Tonn 8/94
' sltonn@phoenix.princeton.edu
' sltonn@eden.rutgers.edu
' jtonn@nerc1.nerc.com
' 75022.401@compuserve.com
DEFINT A-Z 'declare all variables starting with a through z as integers
SCREEN 13 'set screen mode 13, 320x200x256
CLS 'clear screen
RESTORE world 'restore data pointer so all data reading starts after label
' "world"
CONST ACROSS = 11 'this is the number of across tiles that will appear on
'the screen at a time, the total number of across tiles
'is stored in the variable tacross
CONST DOWN = 11 'number of down tiles on screen... total down tiles are
'stored in tdown
DIM blankimg(116) 'create an array for the blank tile
'this tile will be totally black, all zero's
DIM grassimg(116) 'create an array for the grass tile's image, 116 bytes
DIM treeimg(116) 'create an array for the tree tile's image, 116 bytes
DIM playerimg(116)'create as array for the player tile's image, 116 bytes
READ tacross, tdown 'get these values from the big data block "world"
'at the end of this program
TYPE tiletype 'create a type called tiletype
x AS INTEGER 'the tile's x pixel coord
y AS INTEGER 'the tile's y pixel coord
style AS INTEGER 'the tile's style
END TYPE
DIM tile(tacross, tdown) AS tiletype 'declare array "tile" as tiletype
TYPE playertype 'create a type called playertype
x AS INTEGER 'x tile where the player is
y AS INTEGER 'y tile where the player is
px AS INTEGER 'the players "permanant" x tile, the tile that he appears
'in out of the tiles on the screen
py AS INTEGER 'the players "permanant" y tile
END TYPE
DIM player AS playertype 'declare the variable player as a playertype
READ player.x, player.y 'read player x and y coords from data block "world"
player.px = 6
player.py = 6
DEF FNSetlocs 'function to set pixel locs of tiles that appear on screen
FOR a = 1 TO ACROSS
FOR d = 1 TO DOWN
tile(a, d).x = 15 * a 'set pixel x location of tile
tile(a, d).y = 15 * d 'set pixel y location of tile
NEXT d '(all tiles are 15x15 pixels)
NEXT a
END DEF
DEF FNSetAtts 'function to read the styles of all tiles from data block
FOR d = 1 TO tdown
FOR a = 1 TO tacross
READ tile(a, d).style 'read the tile's style
NEXT a
NEXT d
END DEF
'this next routine draws the tile on the screen
'the tx and ty variables are the tile numbers out of all the tiles
'the cx and cy variables are locations of the tile spaces where the tiles
'will be displayed on the screen
DEF FNDrawTile (tx, ty, cx, cy)
SELECT CASE tile(tx, ty).style 'check the tile's style
CASE 0 'if it's 0, draw an array of zero's (a black tile)
PUT (tile(cx, cy).x, tile(cx, cy).y), blankimg, PSET
CASE 1 'if it's 1, draw the grass tile
PUT (tile(cx, cy).x, tile(cx, cy).y), grassimg, PSET
CASE 2 'if it's 2, draw the tree tile
PUT (tile(cx, cy).x, tile(cx, cy).y), treeimg, PSET
END SELECT
END DEF
'this draws all the visible tiles on the screen
'it will draw from 5 tiles to the left of the player to 5 tiles to his right
'and from 5 tiles up to 5 tiles down
DEF FNDrawScreen
FOR rela = -5 TO 5
FOR reld = -5 TO 5
dummy = FNDrawTile(player.x + rela, player.y + reld, player.px + rela, player.py + reld)
NEXT reld
NEXT rela
END DEF
'this function draws the player on the screen in his "permanant" location
DEF FNDrawPlayer
PUT (tile(player.px, player.py).x, tile(player.px, player.py).y), playerimg, PSET
END DEF
DEF FNDisplayImg 'this function will read an images colors from a data block
'and display the image on the screen. Before calling this
'function, reset the data pointer to the beginning of the
'data block for the image.
FOR dp = 1 TO 15
FOR ap = 1 TO 15
READ att 'read the value at the point in the data block
PSET (ap + 10, dp + 10), att 'put the pixel on the screen with the
'color that was read from the data
'block
NEXT ap
NEXT dp
END DEF
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' * * * * * * * * * * * * End of Function Defs* * * * * * * * * * * * * *
dummy = FNSetlocs 'set the locations for the on-screen tiles
dummy = FNSetAtts 'set the styles for all the tiles
GET (11, 11)-(25, 25), blankimg 'get an array that is all zero's, which will
'the black tile that we put around the edges
'of the map. No data reading is needed since
'the screen is already totally black. All
'we need to do is grab a block.
RESTORE grassdata 'restore the data pointer to the beginning of the data
'block that stores the grass tile's image. If you're
'reseting the data pointer to load the images, do it
'after calling FNSetLocs and FNSetAtts, because they
'need the data pointer in a certain place
dummy = FNDisplayImg 'call routine to read and display the image
GET (11, 11)-(25, 25), grassimg 'get the image into array "grassimg"
PUT (11, 11), grassimg, XOR 'put image over existing one to clear it
RESTORE treedata 'restore data pointer to beginning of the tree tile's image
dummy = FNDisplayImg 'read and display the image
GET (11, 11)-(25, 25), treeimg 'get the image into array "treeimg"
PUT (11, 11), treeimg, XOR 'put image on top of the old one to clear it
RESTORE playerdata 'restore pointer to beginning of player tile's image
dummy = FNDisplayImg 'read and display the image
GET (11, 11)-(25, 25), playerimg 'get the image into array "playerimg"
PUT (11, 11), playerimg, XOR 'put image on top of the old one to clear it
dummy = FNDrawScreen 'draw the screen once
dummy = FNDrawPlayer 'draw the player once
DO
kbd$ = INKEY$ 'get a "transparent" input
IF kbd$ <> "" THEN 'if there actually was a user input, then...
kbd$ = RIGHT$(kbd$, 1) 'get the first byte of the input (this is needed
'if you want to look for input from the cursor
'keys)
SELECT CASE kbd$
CASE CHR$(27) 'user pressed escape key
END 'end the program
CASE CHR$(72) 'user pressed up arrow
IF tile(player.x, player.y - 1).style <> 2 THEN
'^^^ check if the tile the player is about to move into is
'already occupied by a tree.
'if you check for a tree, you really don't need to check if
'the player is going to go past the line of trees at the
'edge with the other method, because if you check for a tree,
'it will stop you before you go past the line anyway I just
'added them both in case the reader wanted to use a certain
'method for some reason.
IF player.y - 1 > 5 THEN 'make sure he doesn't go past
'the line of trees. You will
'probably have to change this
'number around if you change the
'player's view screen size
player.y = player.y - 1 'decrease player y tile by one
END IF
dummy = FNDrawScreen 'draw the screen
dummy = FNDrawPlayer 'put the player on the screen
END IF
CASE CHR$(80) 'user pressed down arrow
IF tile(player.x, player.y + 1).style <> 2 THEN
'^^^ check if the tile the player is about to move into is
'already occupied by a tree.
IF player.y + 1 < (tdown - 5) THEN 'keep player on screen
player.y = player.y + 1 'increase player y tile by one
END IF
dummy = FNDrawScreen 'draw the screen
dummy = FNDrawPlayer 'put the player on the screen
END IF
CASE CHR$(75) 'user pressed left arrow
IF tile(player.x - 1, player.y).style <> 2 THEN
'^^^ check if the tile the player is about to move into is
'already occupied by a tree.
IF player.x - 1 > 5 THEN 'keep player on screen
player.x = player.x - 1 'decrease player x tile by one
END IF
dummy = FNDrawScreen 'draw the screen
dummy = FNDrawPlayer 'put the player on the screen
END IF
CASE CHR$(77) 'user pressed right arrow
IF tile(player.x + 1, player.y).style <> 2 THEN
'^^^ check if the tile the player is about to move into is
'already occupied by a tree.
IF player.x < (tacross - 6) THEN 'keep player on screen
player.x = player.x + 1 'increase player x tile by one
END IF
dummy = FNDrawScreen 'draw the screen
dummy = FNDrawPlayer 'put the player on the screen
END IF
END SELECT
END IF
LOOP 'restart the main loop
world:
DATA 30,30
DATA 15,15
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,2,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,2,1,1,1,1,1,2,1,1,1,1,1,2,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,2,1,1,1,1,1,2,1,1,1,1,1,1,2,1,1,1,1,2,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1,2,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,2,1,1,1,1,1,1,1,1,1,1,1,2,1,1,1,2,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,2,1,1,1,1,1,1,1,1,2,1,1,2,1,1,1,2,1,2,0,0,0,0,0
DATA 0,0,0,0,2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,0,0,0,0,0
DATA 0,0,0,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
grassdata:
DATA 0,0,0,0,2,0,0,0,148,0,0,2,0,0,0
DATA 0,2,0,0,0,0,0,0,0,0,0,0,0,0,141
DATA 0,0,0,0,142,0,0,2,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,2,0,0
DATA 0,2,0,2,0,145,0,0,0,142,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,2,0,0,0,0,0,2
DATA 0,0,0,142,0,0,0,0,0,0,0,2,0,0,0
DATA 0,2,0,0,0,142,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,0,0,0,2,0,0,147,0,0
DATA 0,142,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,2,0,0,142,0,0,2,0,0,0,2,0
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 2,0,0,0,0,145,0,2,0,0,0,0,2,0,0
DATA 0,0,0,2,0,0,0,0,0,0,0,0,0,0,142
DATA 145,0,0,0,147,0,0,0,2,0,0,2,0,0,0
treedata:
DATA 0,0,0,2,2,2,2,2,2,2,2,0,0,0,0
DATA 0,0,2,2,2,2,2,2,2,2,2,2,0,0,0
DATA 0,6,2,2,2,2,2,2,2,2,2,6,0,0,0
DATA 0,2,6,2,2,2,2,2,2,2,6,2,0,0,0
DATA 0,2,2,6,2,2,2,2,2,6,2,2,0,0,0
DATA 0,0,2,2,6,2,2,2,6,2,2,0,0,0,0
DATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0
DATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0
DATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0
DATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0
DATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0
DATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0
DATA 0,0,0,0,0,6,6,6,0,0,0,0,0,0,0
DATA 0,0,0,0,6,6,6,6,6,0,0,0,0,0,0
DATA 0,0,0,6,6,6,6,6,6,6,0,0,0,0,0
playerdata:
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,7,7,7,0,0,0,1,0,0
DATA 0,0,0,0,0,0,7,7,7,0,0,0,1,0,0
DATA 0,0,0,0,0,0,7,7,7,0,0,0,1,0,0
DATA 0,0,0,0,0,0,0,7,0,0,0,0,1,0,0
DATA 0,0,0,0,0,0,0,7,0,0,0,0,1,0,0
DATA 0,2,0,2,0,0,0,7,0,0,0,1,1,1,0
DATA 0,2,2,7,7,7,7,7,7,7,7,7,7,0,0
DATA 0,2,2,2,0,0,0,7,0,0,0,0,1,0,0
DATA 0,0,2,0,0,0,0,7,0,0,0,0,1,0,0
DATA 0,0,0,0,0,0,0,7,0,0,0,0,0,0,0
DATA 0,0,0,0,0,0,7,0,7,0,0,0,0,0,0
DATA 0,0,0,0,0,7,0,0,0,7,0,0,0,0,0
DATA 0,0,0,0,7,0,0,0,0,0,7,0,0,0,0
DATA 0,0,0,7,0,0,0,0,0,0,0,7,0,0,0